home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / utility / rexxalgo.zip / RXALGO01.CMD < prev    next >
OS/2 REXX Batch file  |  1996-07-15  |  18KB  |  491 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Description: This file is the collection of some  */
  4. /*            : Rexx-algorithms. Following templates */
  5. /*            : are placed at your's disposal at the */
  6. /*            : moment:                              */
  7. /*            :  1. Binary search                    */
  8. /*            :  2. Bubble sort                      */
  9. /*            :  3. Insertion sort                   */
  10. /*            :  4. Quick sort                       */
  11. /*            :  5. Shell sort                       */
  12. /*            :  6. Square root                      */
  13. /*            :  7. Digital Audio Player (mciRexx)   */
  14. /*            :  8. Translation to lower case        */
  15. /*            :  9. Translation date to the julian   */
  16. /*            :     date                             */
  17. /*            : 10. Translation julian date to the   */
  18. /*            :     date                             */
  19. /*            : All these code templates are written */
  20. /*            : as internal subroutines.             */
  21. /*                                                   */
  22. /* Author.....: Janosch R. Kowalczyk                 */
  23. /*              Oberwaldstr. 42                      */
  24. /*              63538 Grosskrotzenburg / Germany     */
  25. /*              Tel: +49 (0)6186 201676              */
  26. /*              Fax: +49 (0)6186 470                 */
  27. /*              Compuserve: 101572,2160              */
  28. /*                                                   */
  29. /* Create date: 26 May 1996                          */
  30. /* Version....: 1.0                                  */
  31. /*                                                   */
  32. /* Changes....: No                                   */
  33. /*                                                   */
  34. /* Made use of GREED.  26 May 1996 / 12:29:24   JRK  */
  35. /*****************************************************/
  36.  
  37. Say 'This file is the collection of the sample internal'
  38. Say 'Rexx-subroutines with some necessary algorythms such'
  39. Say 'as: various sorts, search, square root...'
  40. Say
  41. Say 'Refer to the source code of this file for more'
  42. Say 'informations, please.'
  43. Say 
  44. Say 'Call the sample test-routine named TESTALG1.CMD to'
  45. Say 'test these procedures.'
  46.  
  47.  
  48. Exit
  49.  
  50. /*===============(Internal subroutines)==============*/
  51.  
  52. /*==================(Binary search)==================*/
  53. /* :-))                                              */
  54. /* Name.......: BiSearch                             */
  55. /*                                                   */
  56. /* Function...: Search a stem variable for a value   */
  57. /* Call parm..: Search value                         */
  58. /* Returns....: 0 if nothing found                   */
  59. /*              index of the found value             */
  60. /* Sample call: found_index = BiSearch(value)        */
  61. /*              If found_index = 0 Then              */
  62. /*                Say 'Value' value 'not found!'     */
  63. /*              Else                                 */
  64. /*                Say stem.found_index               */
  65. /*                                                   */
  66. /* Notes......: The elements to search for must be   */
  67. /*              saved in the stem named so as the    */
  68. /*              stem in this Procedure (in this case */
  69. /*              "STEM.")                             */
  70. /*              stem.0 must contain the number of    */
  71. /*              elements in stem.                    */
  72. /*              The stem-variable must be in the     */
  73. /*              sorted order                         */
  74. /*                                                   */
  75. /* Changes....: No                                   */
  76. /*                                                   */
  77. /*===================================================*/
  78.  
  79. BiSearch: Procedure Expose stem.
  80.  
  81. Parse Arg value           /* Search value            */
  82.  
  83. found  = 0                /* Index of the found Item */
  84. bottom = 1                /* Index of the first Item */
  85. top    = stem.0           /* Index of the last Item  */
  86.  
  87. /*------------------(Binary Search)------------------*/
  88. Do While found = 0 & top >= bottom
  89.   mean = (bottom + top) % 2
  90.   If value = stem.mean Then
  91.     found = mean
  92.   Else If value < stem.mean Then
  93.     top = mean - 1
  94.   Else
  95.     bottom = mean + 1
  96. End /* Do While */
  97.  
  98. Return found
  99.  
  100.  
  101. /*===================(Bubble sort)===================*/
  102. /* :-I                                               */
  103. /* Name.......: BubSort                              */
  104. /*                                                   */
  105. /* Function...: Bubble Sort for a stem variable      */
  106. /* Call parm..: No                                   */
  107. /* Returns....: nothing (NULL string)                */
  108. /*                                                   */
  109. /* Sample call: Call BubSort                         */
  110. /*                                                   */
  111. /* Notes......: The elements to sort for must be     */
  112. /*              saved in the stem named so as the    */
  113. /*              stem in this Procedure (in this case */
  114. /*              "STEM.")                             */
  115. /*              stem.0 must contain the number of    */
  116. /*              elements in stem.                    */
  117. /*                                                   */
  118. /* Changes....: No                                   */
  119. /*                                                   */
  120. /*===================================================*/
  121.  
  122. BubSort: Procedure Expose stem.
  123.  
  124. /*------------(Bubble Sort for the Stem)-------------*/
  125. Do i = stem.0 To 1 By -1 Until flip_flop = 1
  126.   flip_flop = 1
  127.   Do j = 2 To i
  128.     m = j - 1
  129.     If stem.m > stem.j Then Do
  130.       xchg   = stem.m
  131.       stem.m = stem.j
  132.       stem.j = xchg
  133.       flip_flop = 0
  134.     End /* If stem.m ... */
  135.   End /* Do j = 2 ...    */
  136. End /* Do i = stem.0 ... */
  137.  
  138. Return ''
  139.  
  140.  
  141. /*=================(Insertion sort)==================*/
  142. /* :-!                                               */
  143. /* Name.......: InsSort                              */
  144. /*                                                   */
  145. /* Function...: Insertion Sort for a stem variable   */
  146. /* Call parm..: No                                   */
  147. /* Returns....: nothing (NULL string)                */
  148. /*                                                   */
  149. /* Sample call: Call InsSort                         */
  150. /*                                                   */
  151. /* Notes......: The elements to sort for must be     */
  152. /*              saved in the stem named so as the    */
  153. /*              stem in this Procedure (in this case */
  154. /*              "STEM.")                             */
  155. /*              stem.0 must contain the number of    */
  156. /*              elements in stem.                    */
  157. /*                                                   */
  158. /* Changes....: No                                   */
  159. /*                                                   */
  160. /*===================================================*/
  161.  
  162. InsSort: Procedure Expose stem.
  163.  
  164. /*------------(Insertion Sort for Stem)--------------*/
  165. Do x = 2 To stem.0
  166.   xchg = stem.x
  167.   Do y = x - 1 By -1 To 1 While stem.y > xchg
  168.     xchg   = stem.x
  169.     stem.x = stem.y
  170.     stem.y = xchg
  171.     x = y
  172.   End /* Do y = x... */
  173.   stem.x = xchg
  174. End /* Do x = 2 ...  */
  175.  
  176. Return ''
  177.  
  178.  
  179. /*====================(Quick sort)===================*/
  180. /* :-))                                              */
  181. /* Name.......: QSort                                */
  182. /*                                                   */
  183. /* Function...: Quick Sort for a stem variable       */
  184. /* Call parm..: No                                   */
  185. /* Returns....: Left-Right span                      */
  186. /*                                                   */
  187. /* Sample call: Call QSort                           */
  188. /*                                                   */
  189. /* Notes......: The elements to sort for must be     */
  190. /*              saved in the stem named so as the    */
  191. /*              st